home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / Notify.bas < prev    next >
BASIC Source File  |  1997-06-14  |  3KB  |  93 lines
  1. Attribute VB_Name = "MFileNotify"
  2. Option Explicit
  3.  
  4. Public Type TConnection
  5.     sDir As String
  6.     efn As EFILE_NOTIFY
  7.     fSubTree As Boolean
  8.     notifier As IFileNotifier
  9. End Type
  10.  
  11. ' Actually cLastNotify + 1 allowed
  12. Public Const cLastNotify = 28
  13. ' One extra blank item in each array for easy compacting
  14. Public ahNotify(0 To cLastNotify + 1) As Long
  15. Public aconNotify(0 To cLastNotify + 1) As TConnection
  16. Public aerr(errFirst To errLast) As String
  17. ' Count of connected objects managed by class
  18. Public cObject As Long
  19.  
  20. Sub Main()
  21.  
  22.     Dim i As Integer
  23.     For i = 0 To cLastNotify
  24.         ahNotify(i) = hInvalid
  25.     Next
  26.     aerr(errInvalidDirectory) = "Invalid directory"
  27.     aerr(errInvalidType) = "Invalid notification type"
  28.     aerr(errInvalidArgument) = "Invalid argument"
  29.     aerr(errTooManyNotifications) = "Too many notifications"
  30.     aerr(errNotificationNotFound) = "Notification not found"
  31.     BugMessage "Initialized static data"
  32.  
  33.     ' Start the wait loop and return to the caller
  34.     Call SetTimer(hNull, 0, 200, AddressOf WaitForNotify)
  35.     BugMessage "Started Timer"
  36.     
  37. End Sub
  38.  
  39. Sub WaitForNotify(ByVal hWnd As Long, ByVal iMsg As Long, _
  40.                   ByVal idTimer As Long, ByVal cCount As Long)
  41.     ' Ignore all parameters except idTimer
  42.     
  43.     ' This one-time callback is used only to start the loop
  44.     KillTimer hNull, idTimer
  45.     BugMessage "Killed Timer"
  46.  
  47.     Dim iStatus As Long, f As Boolean
  48.     ' Keep waiting for file change events until no more objects
  49.     Do
  50.         '  Wait 100 milliseconds for notification
  51.         iStatus = WaitForMultipleObjects(Count, ahNotify(0), _
  52.                                          False, 100)
  53.         Select Case iStatus
  54.         Case WAIT_TIMEOUT
  55.             ' Nothing happened
  56.             BugMessage "Waited for timeout"
  57.             DoEvents
  58.         Case 0 To Count
  59.             BugMessage "Got a notification"
  60.             ' Ignore errors from client; that's their problem
  61.             On Error Resume Next
  62.             ' Call client object with information
  63.             With aconNotify(iStatus)
  64.                 .notifier.Change .sDir, .efn, .fSubTree
  65.             End With
  66.             ' Wait for next notification
  67.             f = FindNextChangeNotification(ahNotify(iStatus))
  68.             BugAssert f
  69.         Case WAIT_FAILED
  70.             ' Indicates no notification requests
  71.             BugMessage "No notification requests"
  72.             DoEvents
  73.         Case Else
  74.             BugMessage "Can't happen"
  75.         End Select
  76.     ' Class Initialize and Terminate events keep reference count
  77.     Loop Until cObject = -1
  78. End Sub
  79.  
  80. Private Property Get Count() As Long
  81.     Dim i As Long
  82.     For i = 0 To cLastNotify
  83.         If ahNotify(i) = INVALID_HANDLE_VALUE Then Exit For
  84.     Next
  85.     Count = i
  86. End Property
  87.  
  88. Public Sub RaiseError(iErr As Integer)
  89.     Err.Raise vbObjectError + iErr, "FileNotify.CFileNotify", aerr(iErr)
  90. End Sub
  91.     
  92.  
  93.